unit BitGrid;

interface
  type
    Direction = (North,West,South,East);
    tIO       = Array[Direction] of Boolean;
  Const
    Mask      : Array[Direction] of Byte = (8,4,2,1);
    PassThrough : String = '048c159d26ae37bf';
    MaxXsize  : Integer = 1000;
    MaxYsize  : Integer = 1000;
  Var
    InputCount,OutputCount : Longint;

  type
    tBitCell = class
                 private
                   _inputs, _outputs : tIO;
                   _index            : byte;   // current input index value
                   _program          : Array[0..15] of Byte;
                   _dirty            : Boolean;
                   function  GetInput(n: Direction):boolean;
                   procedure SetInput(n: Direction; X : Boolean);
                   function  GetOutput(n: Direction):boolean;
                   function  GetHex : String;
                   procedure SetHex(S: String);
                   function  GetBit(index : byte; n : direction):boolean;
                   procedure SetBit(index : byte; n : direction; X : boolean);
                   procedure Recalc;
                 public
                   Constructor Init;
                   property Input[n : Direction] : Boolean read GetInput write SetInput;
                   property Output[n : Direction] : Boolean read GetOutput;
                   property Index : Byte  read _index;
                   property AsHex : String read GetHex write SetHex;
                   property AsBit[index : byte; n : Direction] : Boolean read GetBit write Setbit;
               end;

    tBitGrid = class
                 private
                   _cells : Array of Array of tBitCell; // dynamic array
                   _xsize,_ysize     : Integer; // can scale to any size
                   function  GetInput(n: Direction; z: Integer):boolean;
                   procedure SetInput(n: Direction; z: Integer; _X : Boolean);
                   function  GetOutput(n: Direction; z : Integer):boolean;
                   procedure ResizeX(NewX : Integer);
                   procedure ResizeY(NewY : Integer);
                   function  GetHex(x,y : Integer) : String;
                   procedure SetHex(x,y : Integer; S: String);
                   procedure MapEdgeToXY(n : Direction; z : integer; var x,y : integer);
                 public
                   Constructor Init;
                   property xSize : Integer read _xSize write ResizeX;
                   property ySize : Integer read _ySize write ResizeY;
                   property Input[n : Direction; z: integer] : Boolean read GetInput write SetInput;
                   property Output[n : Direction; z: integer] : Boolean read GetOutput;
                   property AsHex[x,y : Integer] : String read GetHex write SetHex;
                   procedure Recalc;
               end;

implementation
uses
  sysutils;

  Constructor tBitCell.Init;
  var
    n : Direction;
    i : byte;
  begin
    for n :=  Low(Direction) to High(Direction) do
    begin
      _inputs[n] := false;
      _outputs[n] := false;
    end;
    for i := 0 to 15 do
      _program[i] := 0;
    _index := 0;
    _dirty := false;
  end;

  function tBitCell.GetInput(n: Direction):boolean;
  begin
    GetInput := _inputs[n];
  end;

  procedure tBitCell.SetInput(n : Direction; X : Boolean);
  var
    z : direction;
  begin
    if (_inputs[n] <> X) then   // only do work if it changes
    begin
      Inc(InputCount); // update the global counter
      _inputs[n] := X;
      _Index := 0;
      for z := low(direction) to high(direction) do
        if _inputs[z] then inc(_index,mask[z]);
      _dirty := true;
    end;
  end;

  function tBitCell.GetOutput(n: Direction):boolean;
  begin
    if _dirty then Recalc;
    GetOutput := _outputs[n];
  end;


  function  tBitCell.GetHex : String;
    // calculates the hexadecimal equivalent string for the cell's program
  const
    hexstr : array[0..15] of char = ('0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f');
  var
    i   : integer;
    hex : string;
  begin
    hex := '';
    for i := 0 to 15 do
      hex := hex + hexstr[_program[i]];
    GetHex := Hex;
  end;

  procedure tBitCell.SetHex(S : String);
  const
    hexstr : String = '123456789abcdef';
  var
    i,x : byte;
    sub : string;
  begin
    S := S + '0000000000000000';   // make sure its long enough
    for i := 0 to 15 do
    begin
      sub := s[i+1];
      x := pos(sub,hexstr);     // not found is a zero, so we don't have to subtract
      _program[i] := x;
    end;
    _dirty := true;
  end;

  function  tBitCell.GetBit(index : byte; n : direction):boolean;
  begin
    GetBit := (_program[index] AND (mask[n])) <> 0;
  end;

  procedure tBitCell.SetBit(index : byte; n : direction; X : boolean);
  begin
    If GetBit(index,n) <> X then   // if it's the same, we can ignore it
    begin
      if x then  _program[index] := _program[index] OR mask[n]
           else  _program[index] := _program[index] AND NOT(mask[n]);
      _dirty := true;
    end;
  end;


  procedure tBitCell.Recalc;
  var
    n : direction;
    old_out : boolean;
  begin;
    for n := low(direction) to high(direction) do
    begin
      old_out := _outputs[n];
      _outputs[n] := (_program[_index] AND mask[n]) <> 0;
      if _outputs[n] <> old_out then inc(outputcount);   // global instrumentation
    end;
    _dirty := false;
  end;

// --------- tBitGrid

  function  tBitGrid.GetInput(n: Direction; z: Integer):boolean;
  var
    x, y : integer;
  begin
    MapEdgeToXY(n,z,x,y);
    result := _cells[x,y].GetInput(n);
  end;

  procedure tBitGrid.SetInput(n: Direction; z: Integer; _X : Boolean);
  var
    x, y : integer;
  begin
    MapEdgeToXY(n,z,x,y);
    _cells[x,y].SetInput(n,_X);
  end;

  function  tBitGrid.GetOutput(n: Direction; z : Integer):boolean;
  var
    x, y : integer;
  begin
    MapEdgeToXY(n,z,x,y);
    result := _cells[x,y].GetOutput(n);
  end;

  procedure tBitGrid.Recalc;
  var
    x,y : integer;
  begin
    for x := 0 to xsize - 2 do
      for y := 0 to ysize - 1 do
        _cells[x+1,y].Input[west] := _cells[x,y].Output[East];
    for x := xsize - 2 downto 0 do
      for y := 0 to ysize - 1 do
        _cells[x,y].Input[East] := _cells[x+1,y].Output[West];

    for x := 0 to xsize - 1 do
    begin
      for y := 0 to ysize - 2 do
        _cells[x,y+1].Input[North] := _Cells[x,y].Output[South];
      for y := ysize - 2 downto 0 do
        _cells[x,y].Input[South] := _Cells[x,y+1].Output[North];
    end;
  end;

  procedure tBitGrid.ResizeX(NewX : Integer);
  var
    x,y : integer;
  begin
    if (NewX < 1) or (NewX > MaxXsize) then
      raise ERangeError.CreateFmt('%d is not in the valid range of 1 %d',[NewX,MaxXsize]);
    if (NewX > _xSize) then
    begin // upsize the array here
      SetLength(_Cells,NewX);
      for x := _xSize to NewX-1 do
      begin
        SetLength(_Cells[x],_ySize);
        for y := 0 to _ySize-1 do
        begin
          _Cells[x,y] := tBitCell.Create;
          _Cells[x,y].asHex := Passthrough; // default to passthrough code
        end;
      end;
      _xSize := NewX;
    end;
    if (NewX < _xSize) then
    begin
      // downsize the array here
    end;
  end;

  procedure tBitGrid.ResizeY(NewY : Integer);
  var
    x,y : integer;
  begin
    if (NewY < 1) or (NewY > MaxYsize) then
      raise ERangeError.CreateFmt('%d is not in the valid range of 1 %d',[NewY,MaxYsize]);
    if (NewY > _ySize) then
    begin // upsize the array here
      for x := 0 to _xSize-1 do
      begin
        SetLength(_Cells[x],NewY);
        for y := _ySize to NewY-1 do
        begin
          _Cells[x,y] := tBitCell.Create;
          _Cells[x,y].asHex := Passthrough; // default to passthrough code
        end;
      end;
      _ySize := newY;
    end;
    if (NewY < _ySize) then
    begin
      // downsize the array here
    end;
  end;

  function  tBitGrid.GetHex(x,y : Integer) : String;
  begin
    Result := _Cells[x,y].AsHex;
  end;

  procedure tBitGrid.SetHex(x,y : Integer; S: String);
  begin
    _Cells[x,y].AsHex := S;
  end;

  procedure tBitGrid.MapEdgeToXY(n : Direction; z : integer; var x,y : integer);
  begin
    x := 0;  y := 0;   // safe defaults
    Case n of
      North : x := z;
      South : begin  x := z;  y := _ysize-1; end;
      East  : begin  y := z;  x := _xsize-1; end;
      West  : y := z;
    end;
  end;

  Constructor tBitGrid.Init;
  begin
    SetLength(_Cells,1);       _xSize := 1;
    SetLength(_Cells[0],1);    _ySize := 1;
    _Cells[0,0] := tBitCell.Create;
    _Cells[0,0].asHex := Passthrough; // default to passthrough code
  end;

  initialization
  begin
    InputCount := 0;
    OutputCount := 0;
  end;

end.
